home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / files.swg / 0059_Fixed Relative File Name.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-03-26  |  1.4 KB  |  53 lines
  1. {
  2. You included one of my subroutines in the SWAG-library. Unfortunately
  3. it was buggy. Below you will find the, hopefully, bugfree code.
  4. }
  5.  
  6. function GetRelativeFileName (F: FNameStr): FNameStr;
  7. var
  8.   D: DirStr;
  9.   N: NameStr;
  10.   E: ExtStr;
  11.   i: integer;
  12.   rd: string;
  13. begin
  14.   F := FExpand(F);
  15.   FSplit(F, D, N, E);
  16.   if GetCurDrive = D[1] then begin
  17.     { Same Drive - remove Driveinformation from D }
  18.     Delete (D,1,2);
  19.     F := GetCurDir;
  20.     Delete (F,1,2);
  21.     { Maybe it is a file in a directory higher than the actual directory }
  22.     i := Pos(F,d);
  23.     if i > 0 then begin
  24.       if length(f) = 1 then Delete (d,1,length(F))
  25.                        else Delete (d,1,length(F)+1);
  26.       end
  27.     else begin
  28.       rd := '';
  29.       if Pos(d,F) = 0 then begin
  30.         repeat
  31.           repeat
  32.             rd := d[Ord(d[0])]+rd;
  33.             dec(d[0]);
  34.           until d[Ord(d[0])] = '\';
  35.         until Pos(d,F) > 0;
  36.         end;
  37.       { Maybe it  is a file in a directory lower than the actual directory }
  38.       if length(d)=1 then
  39.          d:= '\'+rd
  40.       else if Pos(d,F) > 0 then begin
  41.         repeat
  42.           rd := '..\'+rd;
  43.           dec (F[0]);
  44.           while F[Ord(F[0])] <> '\' do dec(F[0]);
  45.         until (Pos(F,D) > 0) and not((d='\') and (F<>'\'));
  46.         d := rd;
  47.         end
  48.       end;
  49.     end;
  50.   GetRelativeFileName := lower(D+N+E);
  51. end;
  52.  
  53.